00100	COMMENT ⊗   VALID 00002 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002	C****  VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
00500	C00018 ENDMK
00600	C⊗;
     

00100	C****  VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
00200	
00300		SUBROUTINE FILOUT(NAMQ,NPG)
00400		COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00500		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
00600		1  /SF/KL,RT,KP,STFSZ,NAMX,EXT /IVV/NUMS(1)
00700	2	FORMAT(' TYPE FILE NAME  '$)
00800	102	FORMAT(A5)
00900	103	TYPE 2
01000		CALL READX(5,NAMX,EXT,NPG,NUMS)
01100	CC103	CALL NAMEXT(EXT)
01200		IF(NAMX.NE.' ')GO TO 1
01300		EXT='TST'
01400		NAMX='AAAAA'
01500	1	NAMZ=NAMX
01600		NPG=1
01700		IF(LOOKX(NAMX,EXT).GE.0)GO TO 88
01800		TYPE 88,NAMX,EXT
01900		ACCEPT 102,L
02000		IF(L.EQ.'N')GO TO 103
02100	88	FORMAT(' WRITE OVER FILE ',A5,'.',A3,'????  '$)
02200		END
02300	
02400		SUBROUTINE FILEIN
02500		COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
02600		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 /IPG/IPG,JPG,
02700		1 BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) 
02800		1 /RSP/KNM(1) /ENDL/ENDLN,N,NAME,NMPG,T /KBAR/KBAR(515)
02900		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
03000		COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,LL,I,RXQ
03100		COMMON/STF/RSTFAC(0/7),RSTJ2 /PX/KPN(1) /Q/Q(1)
03200		1 /NBAR/NBAR(1)
03300		EQUIVALENCE (LASTNM,KBAR(3))
03400	
03500	CCC	IF(NMPG.EQ.'PAGEA')NPZ='PAGEZ'
03600		IF(NBAR(LC).EQ.0)CALL EXIT
03700		IF(KPX.EQ.1)GO TO 104
03800	C  SKIP THIS FIRST TIME.  IT SHUFFLES DATA FORWARD IN ARRAY.
03900		J=KPX-1
04000		JJ=KPN(KPX)-1
04100		DO 105 K=1,NPX-J
04200	105	KPN(K)=KPN(K+J)-JJ
04300		J=KPN(NPX)-JJ
04400	C  HOW MUCH TO SHIFT THE Q ARRAY
04500	CX	DO 106 K=1,J
04600	CX106	Q(K)=Q(K+JJ)
04700		CALL RLOOP(Q,Q(JJ+1),J)
04800		KPX =NPX-KPX+1
04900	C  UPDATE POINTERS FOR NEXT READIN
05000		KQ=KPN(KPX)
05100		JPX=KQ-1
05200	
05300	104	KL=1
05400		KP=1
05500		JEND=0
05600	C  FLAG FOR PAGE END - WHEN -1
05700		IF(LB.LT.NBAR(LC))GO TO 220
05800		NPX=KPX
05900		KPX=1
06000		LB=0
06100		GO TO 241
06200	220	CALL GETEXT(NMPG,'PAG')
06300		CALL EXTIN(RSTFAC,22)
06400	211	CALL EXTIN(KPN(KPX),JJ2)
06500		CALL EXTIN(Q(KQ),JPQ)
06600		IF(KPX.EQ.1)GO TO 140
06700	CC	IF(KPX.EQ.LPX)GO TO 311
06800	C  AVOIDS DOUBLE METERS, I HOPE!
06900	CC	IF(Q(KQ+1).NE.18)GO TO 311
07000	C LOOK AT FIRST NEW ITEM, IS IT A METER?
07100	CC	KPX=LPX
07200	CC	KQ=KPN(KPX)
07300	C YES, GO BACK AND READ OVER OLD METERS.
07400	CC	JPX=KQ-1
07500	CC	GO TO 220
07600	311	OLD=Q(KPN(KPX-1)+3)
07700		B=0
07800		JJ=JJ2+KPX-1
07900		DO 420 JP=KPX,JJ
08000		K=KPN(JP)+JPX
08100		KPN(JP)=K
08200		R=Q(K+1)
08300		IF(B.NE.0)GO TO 420
08400		IF(R.LE.2)GO TO 620
08500		IF(R.NE.18)GO TO 420
08600	CHECK UP ON METER DUPLICATE.
08700		DO 720 KK=KPX-1,1,-1
08800		R=CODEN(KPN,KK,Q,LA)
08900	720	IF(R.NE.18)GO TO 820
09000		GO TO 420
09100	820	IF(KK.EQ.KPX-1)GO TO 420
09200		KPX=KK+1
09300		KQ=KPN(KPX)
09400		JPX=KQ-1
09500	C GO BACK AND READ OVER DANGLING METER
09600		GO TO 220
09700	620	B=Q(K+3)
09800	C B=POS OF FIRST NOTE OR REST IN NEW FILE.
09900		DO 1 KK=KPX,JP
10000		R=CODEN(KPN,KK,Q,LA)
10100		IF(R.NE.44)GO TO 7
10200		IF(Q(LA+6).EQ.0.OR.Q(LA).LT.4)GO TO 1
10300	C LOOK AT LINES, CRESC, DASHES, WIGGLES ONLY.
10400		GO TO 2
10500	7	IF(R.NE.7)GO TO 5
10600		IF(Q(LA).LT.5)GO TO 1
10700		RR=ABS(Q(LA+7))
10800		IF(RR.GT.1.AND.RR.LT.8)GO TO 1
10900	C AVOID PEDAL MARKS.
11000		GO TO 2
11100	5	IF(R.NE.5)GO TO 1
11200	C FOUND SLUR INTO LEFT SIDE OF LINE
11300		IF(Q(LA+3))Q(LA+3)=B-5
11400		A=Q(LA+6)
11500		C=Q(LA+2)
11600	2	DO 3 NN=1,KPX-1
11700		RR=CODEN(KPN,NN,Q,II)
11800		IF(RR.NE.R)GO TO 3
11900		IF(Q(II).LT.4)GO TO 3
12000		IF(Q(II+3).GT.D)GO TO 3
12100		IF(Q(II+2).NE.C)GO TO 3
12200	C CATCHES ONLY ONE SLUR(ETC.) POS PER STAFF!!
12300		IF(Q(II+6).LT.D)GO TO 3
12400		Q(II+6)=A
12500	C  ADJUSTS PARAM 6 TO POSITION IN NEW FILE.
12600		GO TO 1
12700	3	CONTINUE
12800	1	CONTINUE
12900	420	CONTINUE
13000	140	JPX=KQ+JPQ-3
13100	C  NUM OF WORDS TO SHIFT.
13200		LPX=KPX
13300	C  SO IT WON'T GET CONFUSED
13400	41	NMPG=NMPG+2
13500	C  NMPG = NAME OF INPUT FILES
13600		IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
13700	C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
13800		IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
13900		IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
14000	CCC	IF(NMPG.LE.NPZ)GO TO 2242
14100	CCC	NPZ=NPZ+256
14200	CCC	NMPG='PAGFA'
14300	CC	L=JJ2-2
14400	CC	NPX=KPX+L
14500	2242	NPX=KPX+JJ2-2
14600	241	JBAR=NBAR(LC)
14700	
14800		DO 20 JP=KPX,NPX-1
14900		R=CODEN(KPN,JP,Q,N)
15000	CC	N=KPN(JP)   	R=Q(N+1)
15100		IF(R.NE.4)GO TO 20
15200	C  FINDS BAR LINES IN THIS PART OF DATA
15300		LB=LB+1
15400		IF(LB.NE.JBAR)GO TO 20
15500		KPX=JP+1
15600		D=Q(N+3)
15700			DO 121 L=JP-1,1,-1
15800			R=CODEN(KPN,L,Q,N)
15900			IF(R.NE.5)GO TO 121
16000			RR=Q(N+6)
16100			IF(RR.LT.D)GO TO 121
16200			Q(N+6)=-1
16300			C=Q(N+2)
16400			B=0
16500				DO 221 KK=JP+1,NPX-1
16600				R=CODEN(KPN,KK,Q,NN)
16700				IF(R.NE.1)GO TO 221
16800				IF(Q(NN+2).NE.C)GO TO 221
16900	C		  CHECK ON STAFF NUM.
17000				A=Q(NN+3)-1
17100				IF(RR.LT.A)GO TO 221
17200				B=B-1
17300				IF(ABS(RR-A).LE.2)GO TO 321
17400	C		IF IT'S CLOSE ENOUGH CALL IT EQUAL.
17500	221			CONTINUE
17600	321		IF(B)Q(N+6)=B
17700	121		CONTINUE
17800	C  SAVE POS OF LAST BAR FOR SLUR CONNECTIONS, ETC.
17900	CC	LPX=KPX
18000	C  SAVE POINTER IN CASE OF DOUBLE METERS.
18100	20	CONTINUE
18200		IF(LB.GE.JBAR)GO TO 520
18300		KPX=NPX
18400		KQ=JPX+1
18500		GO TO 220
18600	520	IF(Q(KPN(KPX)+1).NE.18)GO TO 120
18700	C  LOOKS FOR METER BEYOND LAST BAR IN LINE
18800		IF(KPX.GE.NPX)GO TO 10
18900		KPX=KPX+1
19000		GO TO 520
19100	120	IF(NPX.LE.KPX)GO TO 10
19200		KK=KPX-1
19300		R=Q(KPN(KK)+3)+.5
19400		DO 11 K=KK,NPX
19500		IF(Q(KPN(K)+3).GT.R)GO TO 12
19600	11	KPX=K
19700	C ABOVE CATCHES THINGS IN SAME POS. AS LAST BAR LINE.
19800	12	IF(KPX.LT.NPX)KPX=KPX+1
19900	10	KQ=KPN(KPX)
20000		LB=LB-JBAR
20100		L=KPX-1
20200	C L=TOTAL ITEMS FOR THIS LINE. JBAR=TOTAL BARS, LB=HOW MANY LEFT OVER
20300		I=L
20400		IF(LB.NE.0)RETURN
20500		KPX=1
20600		KQ=1
20700		END
20800	
20900		SUBROUTINE STAVES
21000		DATA SLSP/12.0/
21100		COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
21200		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2/RSIG/RSIG(0/7)
21300		COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK(0/7),
21400		1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(0/7) 
21500		1 /RSP/KNM(1) /ENDL/ENDLN,N,NAME,NMPG,T /KBAR/KBAR(515)
21600		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
21700		1 /STF/RSTFAC(0/7),RSTJ2 /IVV/OSLUR(1)
21800		COMMON /POSI/STFF(0/7),JJ2,JPQ /LLL/L,LL,I,RXQ
21900		1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(1)
22000		DIMENSION ENDSTF(450),STFNM(0/7)
22100	C  ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
22200		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
22300	 	1,(ENDSTF,KBAR(4))
22400		1,(R8,RQ(6)),(R9,RQ(7)),(STFNM,KBAR(508))
22500		IF(LC.EQ.1)RA=0
22600	C RA IS LEFT POS OF Q DATA. (IT SHIFTS AS LC CHANGES.)
22700		KL=1
22800		KP=1
22900		LC=LC+1
23000	335	RX=0
23100		IF(NBAR(LC).EQ.0)JEND=-1
23200	3	JJ=KP
23300	
23400	C ******** PUTS IN STAFF ********
23500		RS=3.
23600	C  RS IS WDCNT FOR SUBR. STAFF
23700		IF(RT.EQ.0)RS=6
23800	C =6 FOR BOTTOM STAFF.  PUTS IN SPACER.
23900	CC331	IF(IPG)GO TO 411
24000		HX=8
24100		G=0
24200		RX=RT
24300		DO 611 JP=1,LPG
24400		RT=RSTNUM(JP)
24500		LA=RT
24600		RS=3
24700	C WD CNT IS RS, HX IS CODE(8), ARRAYS AND LPG(JPG) WERE SET UP IN MAIN.
24800		RR=0
24900		IF(NAMX.EQ.NAMZ)GO TO 11
25000		IF(RT.NE.0)GO TO 11
25100		RS=6
25200		RR=SPG
25300	C  FOR SPACER ON STAFF 0
25400	11	IF(STFNM(LA).NE.0)RS=7
25500	611	CALL STAFF(RS,HX,G,RHGT(JP),RPSZ(JP),G,G,RR,STFNM(LA),G,G,G)
25600	C  STFNM IS INST. NAME IN P9 OF STAFF PARAMS.
25700		HX=LPG
25800		IF(IPG)GO TO 6
25900		RS=4.
26000		RT=0
26100		CALL STAFF(2.,RS,G,HX,G,G,G,G,G,G,G,G)
26200		DO 1611 JP=1,LPG
26300		RT=RSTNUM(JP)
26400		LA=RT
26500		BR=BRACK(LA)
26600		IF(BR.EQ.0)GO TO 1611
26700	    	R7=AMOD(BR,100.)
26800		R4=(BR-R7)/100.
26900		CALL STAFF(5.,RS,G,R4,G,G,R7,G,G,G,G,G)
27000	1611	CONTINUE
27100		RT=RX
27200	CC	GO TO 511
27300	CC411	CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP,SP,SP,SP,SP)
27400	CC	HGT=HGT-HX
27500	CI511	IF(JEND)GO TO 60
27600	C FOR PREMATURE PAGE END
27700	CP	IF(K.NE.I)GO TO 6
27800	CI	IF(RT.EQ.0)GO TO 6
27900	CI60	IF(IPG.EQ.0)GO TO 6
28000	CI	RX=RT
28100	CI	RT=0
28200	CI	CALL STAFF(6.,8.,0,0,0,0,1.,SP,SP,SP,SP,SP)
28300	C  PUTS IN SPACER
28400	CI	RT=RX
28500	
28600	C  ****** NEXT FOR CLEFS ************
28700	6	RX=1
28800		IF(CLEF.EQ.-99)GO TO 33
28900	C  ONLY STAFF FOR FIRST LINE AT TOP.
29000		RX=8.*RSTJ2
29100	C  THE SPACER
29200	CC	LA=0
29300	CC	IF(IPG)GO TO 3011
29400		LA=LPG
29500	3111	RT=RSTNUM(LA)
29600		LL=RT
29700		CLEF=RCLEF(LL)
29800	C GETS CLEF FOR PAGE LAYOUT, RT IS STAFF# IN CALL
29900		LA=LA-1
30000	3011	IF(CLEF.NE.99)CALL STAFF(3.,3.,1.5,0,CLEF,0,0,0,0,0,0,0)
30100		IF(SIG.EQ.-99)GO TO 3211
30200	C  ***** NEXT FOR KEY SIG. ********
30300		RS=4.
30400		R5=RSIG(LL)
30500	332	IF(R5.NE.99)CALL STAFF(RS,17.,10.*RSTJ2,0,R5,CLEF,0,0,0,0,0,0)
30600	3211	IF(LA.GT.0)GO TO 3111
30700		RX=11.*RSTJ2
30800	C  RX SETS POS OF NEXT ITEM ON STAFF
30900		R7=RX
31000	
31100	33	LA=1
31200		KX=0
31300	61	IF(ENDSTF(LA).EQ.0)GO TO 31
31400	C  JUMP IF NO CARRYOVERS FROM PREVIOUS LINE.
31500		R5=ENDSTF(LA+1)
31600		IF(R5.NE.18)GO TO 261
31700	CHECK UP ON METER FROM PREV. LINE.  AVOID DUPLICATE.
31800		DO 361 KK=1,I
31900		R=CODEN(KPN,KK,Q,LL)
32000		IF(R.EQ.4)GO TO 261
32100	C JUMP IF METER FOUND BEFORE 1ST BAR LINE.
32200	361	IF(R.EQ.18)GO TO 161
32300	261	RT=ENDSTF(LA+2)
32400		IF(R5.NE.18)GO TO 461
32500		IF(KX)GO TO 461
32600		KX=-1
32700		RX=RX+4
32800		IF(ENDSTF(LA).GT.4)RX=RX+5
32900	461	CALL STAFF(ENDSTF(LA),ENDSTF(LA+1),ENDSTF(LA+3),ENDSTF(LA+4),
33000		1 ENDSTF(LA+5),ENDSTF(LA+6),ENDSTF(LA+7),ENDSTF(LA+8),
33100		1 ENDSTF(LA+9),ENDSTF(LA+10),ENDSTF(LA+11),ENDSTF(LA+12))
33200	161	LA=LA+13
33300		GO TO 61
33400	
33500	C  RX SPACES NEXT ITEM TO RIGHT OF LINE BEGINNING.
33600	31	R4=Q(KPN(I)+3)
33700	C GET POS OF LAST ITEM FOR THIS LINE
33800		DO 32 K=1,I
33900	32	IF(Q(KPN(K)+3).LT.R4)R4=Q(KPN(K)+3)
34000	C ALL THIS NEEDED BECAUSE OF GRACE NOTE AT START OF LINE PROBLEM.
34100	
34200		IF(RA.LT.R4)RA=R4
34300		R4=RA-.1
34400	C  -.1  FOR ROUND-OFF ERRORS
34500		LA=I
34600		DO 831 K=1,I
34700		KK=KPN(K)+3
34800	C FIND SLURS ETC. BEFORE 1ST NOTES OR REST. (NOT NEG.)
34900		IF(Q(KK).GE.RA)GO TO 231
35000	831	Q(KK)=0
35100	231	RA=CODEN(KPN,LA,Q,K4)
35200		IF(RA.EQ.4)GO TO 131
35300		IF(RA.NE.44)GO TO 931
35400		IF(Q(K4).LE.2)GO TO 131
35500	CATCHES BAR LINES ON UPPER STAVES.
35600	931	LA=LA-1
35700		GO TO 231
35800	131	RA=Q(K4+3)
35900		R5=RA+.001
36000	C +.001 IS TO CATCH SLIGHT ROUNDOFF ERRORS WHEN CODE 44 IS LAST ITEM.
36100		DO 731 K=1,I
36200	CC	KK=KPN(K)  	R=Q(KK+1)
36300		R=CODEN(KPN,K,Q,KK)
36400		IF(R.EQ.44)GO TO 631
36500		IF(R.EQ.7)GO TO 631
36600		IF(R.NE.5)GO TO 731
36700	631	IF(Q(KK).LT.4)GO TO 731
36800		R=Q(KK+6)
36900		IF(R.LT.R5)GO TO 731
37000		Q(KK+6)=R5
37100	C  CATCHES RIGHT SIDE OF THINGS FOR MOVER. (PEDS?)
37200	731	CONTINUE
37300		RS=-1
37400	C  -1 SO ALL STAVES WILL MOVE AT ONCE.
37500	CC	RS=0
37600		R7=0
37700	C R7=0 FOR GETPTS TO LOOK AT ALL STAVES.
37800		R8=RX
37900		R9=200.
38000		LL=0
38100		L=I
38200		CALL PTMOVE(Q,KPN)
38300		IF(LA.EQ.I)RETURN
38400	C NEXT PUTS METER JUST BEYOND END OF LINE
38500		R=202
38600		R7=Q(KPN(LA+1)+3)
38700	C  R7 HOLDS STAFF NUM. FOR THINGS BEYOND END OF LINE.
38800		DO 531 K5=LA+1,I
38900		K7=KPN(K5)
39000		K4=0
39100		IF(Q(K7+1).EQ.18)K4=Q(K7+5)*100+Q(K7+6)
39200	C  K4 STORES METER (TOP*100+BOTTOM)
39300		IF(Q(K7+3).EQ.R7)GO TO 531
39400		R7=Q(K7+3)
39500	C THIS PROBABLY WON'T ALWAYS DO THE RIGHT THING!!
39600		R=R+5
39700	CM	IF(MTR1.GT.0.AND.K4.NE.0)MTR2=K4
39800	531	Q(K7+3)=R
39900	CM431	Q(K7+3)=R
40000	CM531	IF(K4.NE.0.AND.MTR1)MTR1=K4
40100		END
40200